home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 008a / perl40_2.zip / DOS_USUB.C < prev    next >
C/C++ Source or Header  |  1991-12-25  |  1KB  |  65 lines
  1. #include "EXTERN.h"
  2. #include "perl.h"
  3.  
  4. char *savestr();
  5. unsigned long heapfree();
  6. unsigned long stkfree();
  7.  
  8. static enum usersubs {
  9.     US_heapfree,
  10.     US_stkfree,
  11. };
  12.  
  13. static int usersub();
  14.  
  15. int
  16. init_dos()
  17. {
  18.     char *filename = "doslocal.c";
  19.  
  20. #define MAGICVAR(name, ix) uf.uf_index = ix, magicname(name, &uf, sizeof uf)
  21.  
  22.     make_usub("heapfree",    US_heapfree,    usersub, filename);
  23.     make_usub("stkfree",    US_stkfree,    usersub, filename);
  24. };
  25.  
  26. static int
  27. usersub(ix, sp, items)
  28. int ix;
  29. register int sp;
  30. register int items;
  31. {
  32.     STR **st = stack->ary_array + sp;
  33.     register int i;
  34.     register char *tmps;
  35.     register STR *Str;        /* used in str_get and str_gnum macros */
  36.  
  37.     switch (ix) {
  38.     case US_heapfree:
  39.     if (items != 0)
  40.         fatal("Usage: &heapfree()");
  41.     else {
  42.         unsigned long retval;
  43.  
  44.         retval = heapfree();
  45.         str_numset(st[0], (double) retval);
  46.     }
  47.     return sp;
  48.  
  49.     case US_stkfree:
  50.     if (items != 0)
  51.         fatal("Usage: &stkfree()");
  52.     else {
  53.         unsigned long retval;
  54.  
  55.         retval = stkfree();
  56.         str_numset(st[0], (double) retval);
  57.     }
  58.     return sp;
  59.  
  60.     default:
  61.     fatal("Unimplemented user-defined subroutine");
  62.     }
  63.     return sp;
  64. }
  65.